home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / elan1v5.arc / DRAGON.ARC / DRAGPACK.E < prev    next >
Text File  |  1989-03-10  |  2KB  |  68 lines
  1.  
  2. PROC move (INT CONST dir):
  3.   x INCR dx [dir];
  4.   y INCR dy [dir];
  5.   move (round (x), round (y))
  6. ENDPROC move;
  7.  
  8. PROC draw dragon (INT CONST day, cell):
  9.   IF day = 0
  10.   THEN draw cell (cell)
  11.   ELSE
  12.     INT VAR i;
  13.     FOR i FROM 1 UPTO children
  14.     REP
  15.       INT CONST next :: offsprings [cell + 1] [i];
  16.       IF next >= 0
  17.       THEN draw dragon (day - 1, next)
  18.       FI
  19.     ENDREP
  20.   FI
  21. ENDPROC draw dragon;
  22.  
  23. PROC draw cell (INT CONST cell):
  24.   INT CONST b :: behavior [cell + 1] + 1;
  25.   IF b = 0
  26.   THEN
  27.   ELIF b <= directions
  28.   THEN draw (b)
  29.   ELSE move (b - directions)
  30.   FI
  31. ENDPROC draw cell;
  32.  
  33. PROC draw (INT CONST dir):
  34.   x INCR dx [dir];
  35.   y INCR dy [dir];
  36.   draw (round (x), round (y))
  37. ENDPROC draw;
  38.  
  39. start drawing:
  40.   init steps;
  41.   enter graphics mode;
  42.   move ((graphics x limit - length (dragon name) * character width) DIV 2, 1);
  43.   put (dragon name);
  44.   line (2);
  45.   TEXT CONST t :: "For details: Creating fractals; Byte, Aug.1987, pp.123.";
  46.   move ((graphics x limit - length (t) * character width) DIV 2, current y position);
  47.   put (t);
  48.   REAL VAR x :: real (start x), y :: real (start y);
  49.   move (start x, start y).
  50.  
  51. init steps:
  52.   ROW directions REAL VAR dx, dy;
  53.   INT VAR i;
  54.   REAL CONST s :: real (size of cell);
  55.   FOR i FROM 1 UPTO directions
  56.   REP
  57.     REAL CONST a :: 2.0 * pi * real (i - 1) / real (directions);
  58.     dx [i] := aspect * s * cos (a);
  59.     dy [i] := s * sin (a)
  60.   ENDREP.
  61.  
  62. finish drawing:
  63.   move (1, graphics y limit - line height);
  64.   put ("Hit any key!");
  65.   TEXT CONST wait :: inchar;
  66.   enter text mode.
  67.  
  68. ⇦